A 入门技巧
B 编程
019 取得控件绝对Top值 98-8-14
Public Function AbsoluteTop(ctlContl As Control) As Single
Dim wrkContl As Control
Dim wrkTopPos As Single
'
On Error GoTo AbsoluteTopError
' 初始
Set wrkContl = ctlContl
wrkTopPos = 0
' 循环
Do
If (wrkContl.Container.Name = ctlContl.Parent.Name) Then Exit Do
wrkTopPos = wrkTopPos + wrkContl.Top ' 计算位置
Set wrkContl = wrkContl.Container ' 下个控件
Loop
AbsoluteTop = wrkTopPos + ctlContl.Parent.Top
Exit Function
'
AbsoluteTopError:
AbsoluteTop = ctlContl.Top + ctlContl.Parent.Top
Exit Function
End Function
018 延时函数 98-7-16
定义函数：
Public Function Delay(Mins%, Secs%, Optional ByRef StopFlag) As Long
Dim EndOfDelay
EndOfDelay = DateAdd("n", Mins, Now)
EndOfDelay = DateAdd("s", Secs, EndOfDelay)
Delay = 0
Do While (Now < EndOfDelay)
DoEvents
If Not IsMissing(StopFlag) Then
If StopFlag Then
Delay = 1
StopFlag = False
Exit Do
End If
End If
Loop
End Function
使用例子：
Dim StopTheTimer As Boolean
Private Sub Command1_Click() '开始延时
Dim lRetval&
lRetval = Delay(1, 5, StopTheTimer)
If lRetval = 0 Then
MsgBox "时间到!"
Else
MsgBox "取消延时!"
End If
End Sub
Private Sub Command2_Click() '取消延时
StopTheTimer = True
End Sub
017 在字符串中使用双引号 98-7-16
使用 Chr$(34) 连接是个办法，用 "" 更简单。
如： MyName = "我的名字是 ""Ken""。"
016 奇数和偶数校验 98-7-16
If i% And 1 Then
'奇数
Else
'偶数
End If
又 ：偶数校验：
bool_IsEven = int_Number MOD 2 = 0
bool_IsEven = int_Number AND 1 = 0
015 生成不同的8 位口令 98-7-01
Function GenPass() As String
i = 0
UseChar = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
word = ""
Randomize
For i = 1 To 8
word = word + Mid(UseChar, Len(UseChar) * Rnd + 1, 1)
Next i
GenPass = word
End Function
014 利用集合过滤重复的值 98-6-07
Dim i As Long
Dim RawData As String
Dim DataValues As New Collection
On Error Resume Next
' 忽略 error 457 - Duplicate key
For i = LBound(arr) To UBound(arr)
RawData = arr(i)
DataValues.Add RawData, RawData
Next
On Error GoTo 0
' 放到 ListBox 中
lstSortedData.Clear
For Each DataValue In DataValues
lstSortedData.AddItem DataValue
Next
013 成组更新控件属性
下面是成组更新 Enabled 属性的例子：
Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)
Dim obj As Variant
For Each obj In objs
obj.Enabled = Enabled
Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2
012 取得汉字的拼音首字 98-7-31
用以下的函数可以得到汉字的拼音首字字符，注意：对 噢、杞、
嘌、呤 是个例外。
对很多汉字无法正确的实现转换，
原因是在该程序根据汉字在编码表中的位置来判断的，
而部分的汉字所在的位置有误，所以 。。。。
Public Function GetPY(a1 As String) As String
Dim t1 As String
If Asc(a1) < 0 Then
t1 = Left(a1, 1)
If Asc(t1) < Asc("啊") Then
GetPY = "0"
Exit Function
End If
If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
GetPY = "A"
Exit Function
End If
If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
GetPY = "B"
Exit Function
End If
If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
GetPY = "C"
Exit Function
End If
If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
GetPY = "D"
Exit Function
End If
If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
GetPY = "E"
Exit Function
End If
If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
GetPY = "F"
Exit Function
End If
If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
GetPY = "G"
Exit Function
End If
If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
GetPY = "H"
Exit Function
End If
If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
GetPY = "J"
Exit Function
End If
If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
GetPY = "K"
Exit Function
End If
If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
GetPY = "L"
Exit Function
End If
If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
GetPY = "M"
Exit Function
End If
If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
GetPY = "N"
Exit Function
End If
If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
GetPY = "O"
Exit Function
End If
If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
GetPY = "P"
Exit Function
End If
If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
GetPY = "Q"
Exit Function
End If
If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
GetPY = "R"
Exit Function
End If
If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
GetPY = "S"
Exit Function
End If
If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
GetPY = "T"
Exit Function
End If
If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
GetPY = "W"
Exit Function
End If
If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
GetPY = "X"
Exit Function
End If
If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
GetPY = "Y"
Exit Function
End If
If Asc(t1) >= Asc("匝") Then
GetPY = "Z"
Exit Function
End If
Else
If UCase(a1) <= "Z" And UCase(a1) >= "A" Then
GetPY = UCase(Left(a1, 1))
Else
GetPY = "0"
End If
End If
End Function
011 不定个数的参数
如果要传递不定个数的参数给过程，该过程应如下定义：
Sub MySub( ParamArray P() ) '参数定义为一个数组
以下的可能的调用：
MySub "ABC"
MySub 1, 3, 9, 988, 776, 234
MySub 123, "abc", Date()
可用以下的方法来读每个参数：
For i = 0 To UBound(P)
' P(i) 为第 i 个参数
Next
010 混合字符串的长度
在中文环境下，每个字被当做两个 Byte ：
Len("汉1") = 2
LenB("汉1") = 4
但在许多情况下，我们希望中文字长度为 2，英文字符为 1。可用以下的函数：
LenB(StrConv("汉1"), vbFormUnicode))
009 取得应用所在的目录 98-7-04
使用 App.Path 可以得到应用所在的目录。不过得注意，当在根目录下时，Path 的返回值最右字符为 “\” ，如“c:\”，而如果不在根目录，则最右字符非 “\”，如“c:\vb5”。所以在使用 Path 做连接时，应使用以下的代码：
Dim FileName as string
Dim fullpath As String
If Right(App.Path, 1) = "\" Then
fullpath = App.Path + FileName
Else
fullpath = App.Path + "\" + FileName
End If
或者：
pth$ = app.Path & IIf(Len(app.Path) > 3, "\", "")
008 清除字符串中指定的字符
该函数在字符串 s 中清除 Search（注意：如果 s 为 AAABBB，Search 为 AB。如何？） ：
Function StringCleaner(s As String, Search As String) As String
Dim i As Integer, res As String
res = s
Do While InStr(res, Search)
i = InStr(res, Search)
res = Left(res, i - 1) & Mid(res, i + 1)
Loop
StringCleaner = res
End Function
007 快速交换整数
可用以下的代码快速交换两个整数（Interger）：
a = a xor b
b = a xor b
a = a xor b
006 代码块注释和块取消注释
VB5 的新功能，你可以成块地将代码注释或取消注释，在调试时特别有用。请使用 注释块/取消注释块 命令对。
“注释块”和“取消注释块”命令可以在“编辑”工具栏中找到。使用这些命令使多行代码成为注释块，或从一块代码中删除注释字符：
1. 添加“编辑”工具栏。在“编辑”菜单上选择“工具栏”命令，然后选择“编辑”；或将光标放在工具栏上，按右鼠标键，然后选择“编辑”。
2. 打开代码模块，并且突出显示希望创建注释块的代码，或希望从中删除注释字符的代码。
3. 按“编辑”工具栏上的“注释块”或“取消注释块”按钮。
或者代码将移入一个块，并且添加了注释字符；或者被分离成独立的代码片段，并且从中删除了注释字符。
005 闰年测试
Function IsLeap(sYear As String) As Integer
If IsDate("02/29/" & sYear) Then
IsLeap = True
Else
IsLeap = False
End If
End Function
004 使用 IIF 和 SWITCH 以精减代码
在很多地方你都可以使用一个更紧凑的 IIf 函数来代替 If...Else...Endif 的结构：
例：返回两个值中较大的一个
maxValue = IIf(first >= second, first, second)
Switch 则是一个很少使用的函数，可是在很多方面它都提供比 If...ElesIf 结构更好的
例：判断 "x" 是正、负还是 null?
Print Switch(x<0,"负",x>0,"正", True, "Null")
003 Val 与 CDbl
Print Val("12345")
12345
Print Val("12,345")
12
Print CDbl("12,345")
12345
Print CDbl("12345")
12345
002 计算年龄
Function CalcAge(datEmpDateOfBirth as Variant) as Integer
CalcAge = Int(DateDiff("y",datEmpDateOfBirth,Date())/365.25)
End Function
001 快速切换Boolean值
切换Boolean值，试以下的代码:
OptSwitch.Enabled = NOT OptSwitch.Enabled
